home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
os2
/
octa209s.zip
/
octave-2.09
/
libcruft
/
quadpack
/
dqpsrt.f
< prev
next >
Wrap
Text File
|
1996-07-19
|
4KB
|
130 lines
SUBROUTINE DQPSRT(LIMIT,LAST,MAXERR,ERMAX,ELIST,IORD,NRMAX)
C***BEGIN PROLOGUE DQPSRT
C***REFER TO DQAGE,DQAGIE,DQAGPE,DQAWSE
C***ROUTINES CALLED (NONE)
C***REVISION DATE 810101 (YYMMDD)
C***KEYWORDS SEQUENTIAL SORTING
C***AUTHOR PIESSENS,ROBERT,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN
C DE DONCKER,ELISE,APPL. MATH. & PROGR. DIV. - K.U.LEUVEN
C***PURPOSE THIS ROUTINE MAINTAINS THE DESCENDING ORDERING IN THE
C LIST OF THE LOCAL ERROR ESTIMATED RESULTING FROM THE
C INTERVAL SUBDIVISION PROCESS. AT EACH CALL TWO ERROR
C ESTIMATES ARE INSERTED USING THE SEQUENTIAL SEARCH
C METHOD, TOP-DOWN FOR THE LARGEST ERROR ESTIMATE AND
C BOTTOM-UP FOR THE SMALLEST ERROR ESTIMATE.
C***DESCRIPTION
C
C ORDERING ROUTINE
C STANDARD FORTRAN SUBROUTINE
C DOUBLE PRECISION VERSION
C
C PARAMETERS (MEANING AT OUTPUT)
C LIMIT - INTEGER
C MAXIMUM NUMBER OF ERROR ESTIMATES THE LIST
C CAN CONTAIN
C
C LAST - INTEGER
C NUMBER OF ERROR ESTIMATES CURRENTLY IN THE LIST
C
C MAXERR - INTEGER
C MAXERR POINTS TO THE NRMAX-TH LARGEST ERROR
C ESTIMATE CURRENTLY IN THE LIST
C
C ERMAX - DOUBLE PRECISION
C NRMAX-TH LARGEST ERROR ESTIMATE
C ERMAX = ELIST(MAXERR)
C
C ELIST - DOUBLE PRECISION
C VECTOR OF DIMENSION LAST CONTAINING
C THE ERROR ESTIMATES
C
C IORD - INTEGER
C VECTOR OF DIMENSION LAST, THE FIRST K ELEMENTS
C OF WHICH CONTAIN POINTERS TO THE ERROR
C ESTIMATES, SUCH THAT
C ELIST(IORD(1)),..., ELIST(IORD(K))
C FORM A DECREASING SEQUENCE, WITH
C K = LAST IF LAST.LE.(LIMIT/2+2), AND
C K = LIMIT+1-LAST OTHERWISE
C
C NRMAX - INTEGER
C MAXERR = IORD(NRMAX)
C
C***END PROLOGUE DQPSRT
C
DOUBLE PRECISION ELIST,ERMAX,ERRMAX,ERRMIN
INTEGER I,IBEG,IDO,IORD,ISUCC,J,JBND,JUPBN,K,LAST,LIMIT,MAXERR,
* NRMAX
DIMENSION ELIST(LAST),IORD(LAST)
C
C CHECK WHETHER THE LIST CONTAINS MORE THAN
C TWO ERROR ESTIMATES.
C
C***FIRST EXECUTABLE STATEMENT DQPSRT
IF(LAST.GT.2) GO TO 10
IORD(1) = 1
IORD(2) = 2
GO TO 90
C
C THIS PART OF THE ROUTINE IS ONLY EXECUTED IF, DUE TO A
C DIFFICULT INTEGRAND, SUBDIVISION INCREASED THE ERROR
C ESTIMATE. IN THE NORMAL CASE THE INSERT PROCEDURE SHOULD
C START AFTER THE NRMAX-TH LARGEST ERROR ESTIMATE.
C
10 ERRMAX = ELIST(MAXERR)
IF(NRMAX.EQ.1) GO TO 30
IDO = NRMAX-1
DO 20 I = 1,IDO
ISUCC = IORD(NRMAX-1)
C ***JUMP OUT OF DO-LOOP
IF(ERRMAX.LE.ELIST(ISUCC)) GO TO 30
IORD(NRMAX) = ISUCC
NRMAX = NRMAX-1
20 CONTINUE
C
C COMPUTE THE NUMBER OF ELEMENTS IN THE LIST TO BE MAINTAINED
C IN DESCENDING ORDER. THIS NUMBER DEPENDS ON THE NUMBER OF
C SUBDIVISIONS STILL ALLOWED.
C
30 JUPBN = LAST
IF(LAST.GT.(LIMIT/2+2)) JUPBN = LIMIT+3-LAST
ERRMIN = ELIST(LAST)
C
C INSERT ERRMAX BY TRAVERSING THE LIST TOP-DOWN,
C STARTING COMPARISON FROM THE ELEMENT ELIST(IORD(NRMAX+1)).
C
JBND = JUPBN-1
IBEG = NRMAX+1
IF(IBEG.GT.JBND) GO TO 50
DO 40 I=IBEG,JBND
ISUCC = IORD(I)
C ***JUMP OUT OF DO-LOOP
IF(ERRMAX.GE.ELIST(ISUCC)) GO TO 60
IORD(I-1) = ISUCC
40 CONTINUE
50 IORD(JBND) = MAXERR
IORD(JUPBN) = LAST
GO TO 90
C
C INSERT ERRMIN BY TRAVERSING THE LIST BOTTOM-UP.
C
60 IORD(I-1) = MAXERR
K = JBND
DO 70 J=I,JBND
ISUCC = IORD(K)
C ***JUMP OUT OF DO-LOOP
IF(ERRMIN.LT.ELIST(ISUCC)) GO TO 80
IORD(K+1) = ISUCC
K = K-1
70 CONTINUE
IORD(I) = LAST
GO TO 90
80 IORD(K+1) = LAST
C
C SET MAXERR AND ERMAX.
C
90 MAXERR = IORD(NRMAX)
ERMAX = ELIST(MAXERR)
RETURN
END